{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Descriptor;

interface

uses Classes, XmlHelper;

type
  TAHMDescriptorStatus = (dsUnknown, dsValid, dsInvalid);

  TAHMDescriptorClass = class of TAHMDescriptor;

  TAHMDescriptor = class
  private
  protected
    FInitialised: Boolean;
    FName: String;
    FDescription: String;
    FFileName: String;
    FRootTagName: String;
    FMandatory: Boolean;
    FParsed: Boolean;
    FParseNode: TAHMXMLNode;
    FHelper: TAHMXMLHelper;
    procedure ResetDefaults; virtual;
    procedure ParseXML; overload; virtual;
    procedure SaveXMLRoot(Lines: TStrings); virtual;
    procedure SaveAsXML(Lines: TStrings); overload; virtual;
    procedure LogParsingError(const sErrorCode: String); virtual;
    procedure SetBaseDescriptor(Base: TAHMDescriptor); virtual;
    function GetSaveRequired: Boolean; virtual;
  public
    constructor Create; virtual;
    property Name: String read FName write FName;
    property Description: String read FDescription write FDescription;
    property Mandatory: Boolean read FMandatory write FMandatory;
    property Parsed: Boolean read FParsed write FParsed;
    property BaseDescriptor: TAHMDescriptor write SetBaseDescriptor;
    property Initialised: Boolean read FInitialised;
    property SaveRequired: Boolean read GetSaveRequired;
    procedure Initialise; virtual;
    function ParseXML(const Filepath: String): Boolean; overload; virtual;
    procedure SaveAsXML(const Filepath: String); overload;
    procedure Assign(Source: TAHMDescriptor); virtual;
    procedure Sort; virtual;
  end;

  TAHMDescriptorList = class
  private
    FList: TStringList;
  protected
    function GetCount: Integer;
    function GetDescriptor(Index: Integer): TAHMDescriptor;
    function GetDescriptorByName(Name: String): TAHMDescriptor;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Descriptor[Index: Integer]: TAHMDescriptor read GetDescriptor;
    property DescriptorByName[Name: String]: TAHMDescriptor read GetDescriptorByName; default;
    procedure Clear;
    function Add(DescriptorClass: TAHMDescriptorClass; DescriptorName: String): TAHMDescriptor; overload;
    function Add(Descriptor: TAHMDescriptor): Boolean; overload;
    function Delete(Descriptor: TAHMDescriptor; FreeDescriptor: Boolean = True): Boolean;
    function Rename(Descriptor: TAHMDescriptor; NewDescriptorName: String): Boolean;
  end;

implementation

uses SysUtils, XMLTags, TagNames, ErrorCodes, AHMTypes;

// TAHMDescriptor

constructor TAHMDescriptor.Create;
begin
  inherited Create;

  // Assume all descriptors are mandatory (i.e. must exist)
  FMandatory := True;

  // Initialise default values for descriptor
  ResetDefaults;
end;

procedure TAHMDescriptor.ResetDefaults;
begin
  // Descendants may implement this to set any default properties
end;

procedure TAHMDescriptor.SetBaseDescriptor(Base: TAHMDescriptor);
begin
  // Descendants will implement this to link individual lists
end;

function TAHMDescriptor.GetSaveRequired: Boolean;
begin
  // Descendants may implement this to be more selective
  Result := True;
end;

procedure TAHMDescriptor.Initialise;
begin
  // Descendants may perform additional initialisation steps as required
  Sort;
  FInitialised := True;
end;

procedure TAHMDescriptor.ParseXML;
begin
  // Descendants will implement this method to perform XML parsing
end;

function TAHMDescriptor.ParseXML(const Filepath: String): Boolean;
var
  RootNode: TAHMXMLNode;
begin
  // If we already parsed then just exit with success result
  Result := FParsed;
  if Result then Exit else FParsed := True;

  // Reset default values before parsing
  ResetDefaults;

  // If this is an optional file which does not exist then return success
  if not (FMandatory or FileExists(FilePath + FFileName)) then
  begin
    Result := True;
    Exit;
  end;

  // Create XML Helper to parse the file
  FHelper := TAHMXMLHelper.Create(Filepath + FFileName);
  try
    try
      // Ignore preamble - we're looking for a root Descriptor node
      if not FHelper.FindRootElement(RootNode, FRootTagName) then
        LogParsingError(THM_PRS_DSC_MISSING_DESCRIPTOR_START_TAG);

      // Save our descriptor attributes
      if FName = '' then FName := FHelper.GetAttribute(ATTR_NAME);
      FDescription := FHelper.GetAttribute(ATTR_DESC);

      // Parse XML body - may raise an exception
      ParseXML;

      // No exception, parsed successfully
      Result := True;
    except
      on E:Exception do
        raise EParsingException.Create(Format(THM_PRS_DSC_MESSAGE_PREFIX, [FRootTagName]) + E.Message);
    end;
  finally
    FHelper.Free;
  end;
end;

procedure TAHMDescriptor.SaveXMLRoot(Lines: TStrings);
var
  sWork: String;
begin
  // Descendants may override this method to customise root tag format
  sWork := TGB + FRootTagName;
  if FName <> '' then sWork := sWork + SPC+ATTR_NAME+ATB + EncodeXML(FName) + ATQ;
  if FDescription <> '' then sWork := sWork + SPC+ATTR_DESC+ATB + EncodeXML(FDescription) + ATQ;

  // Add root tag with attributes
  Lines.Add(sWork + TGC);
end;

procedure TAHMDescriptor.SaveAsXML(Lines: TStrings);
begin
  // Descendants will implement this to store descriptor in XML format
end;

procedure TAHMDescriptor.SaveAsXML(const Filepath: String);
var
  Buffer: TStringList;
begin
  // Persist this descriptor if needed
  if SaveRequired then
  begin
    Buffer := TStringList.Create;
    try
      Buffer.Add(XML_PREAMBLE);
      SaveXMLRoot(Buffer);
      SaveAsXML(Buffer);
      Buffer.Add(EndTag(FRootTagName));

      Buffer.SaveToFile(FilePath + FFileName);
    finally
      Buffer.Free;
    end;
  end;
end;

procedure TAHMDescriptor.Assign(Source: TAHMDescriptor);
begin
  // Copy properties from source descriptor
  FName := Source.Name;
  FDescription := Source.Description;
  FParsed := Source.Parsed;
  FMandatory := Source.Mandatory;
end;

procedure TAHMDescriptor.Sort;
begin
  // Descendants may override this to implement sorting if required
end;

procedure TAHMDescriptor.LogParsingError(const sErrorCode: String);
begin
  // Descendants may override this to log any errors encountered whilst parsing
  raise EParsingException.Create(sErrorCode);
end;


// TAHMDescriptorList

constructor TAHMDescriptorList.Create;
begin
  inherited;

  FList := TStringList.Create;
  FList.CaseSensitive := False;
end;

destructor TAHMDescriptorList.Destroy;
begin
  Clear;
  FList.Free;

  inherited;
end;

function TAHMDescriptorList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TAHMDescriptorList.GetDescriptor(Index: Integer): TAHMDescriptor;
begin
  Result := TAHMDescriptor(FList.Objects[Index]);
end;

function TAHMDescriptorList.GetDescriptorByName(Name: String): TAHMDescriptor;
var
  i: Integer;
begin
  i := FList.IndexOf(Name);
  if i < 0 then Result := nil
           else Result := TAHMDescriptor(FList.Objects[i]);
end;

procedure TAHMDescriptorList.Clear;
var
  i: Integer;
begin
  for i := Pred(FList.Count) downto 0 do
    TAHMDescriptor(FList.Objects[i]).Free;
  FList.Clear;
end;

function TAHMDescriptorList.Add(DescriptorClass: TAHMDescriptorClass; DescriptorName: String): TAHMDescriptor;
begin
  Result := DescriptorClass.Create;
  Result.Name := DescriptorName;
  FList.AddObject(DescriptorName, Result);
end;

function TAHMDescriptorList.Add(Descriptor: TAHMDescriptor): Boolean;
begin
  Result := Assigned(Descriptor);
  if Assigned(Descriptor) then
    FList.AddObject(Descriptor.Name, Descriptor);
end;

function TAHMDescriptorList.Delete(Descriptor: TAHMDescriptor; FreeDescriptor: Boolean): Boolean;
var
  i: Integer;
begin
  // Set default result - failed to delete
  Result := False;

  if Assigned(Descriptor) then
  begin
    i := FList.IndexOfObject(Descriptor);
    if i >= 0 then FList.Delete(i);
    if FreeDescriptor then Descriptor.Free;
    Result := True;
  end;
end;

function TAHMDescriptorList.Rename(Descriptor: TAHMDescriptor; NewDescriptorName: String): Boolean;
var
  i: Integer;
begin
  // Set default result - failed to rename
  Result := False;

  if Assigned(Descriptor) then
  begin
    i := FList.IndexOfObject(Descriptor);
    if i < 0 then Exit;

    Descriptor.Name := NewDescriptorName;
    FList.Strings[i] := NewDescriptorName;
    Result := True;
  end;
end;

end.
